PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/sthing.com/STRES.PAS

Pascal/Delphi Source File | 1990-10-28 | 12.6 KB | 495 lines

{
  STRES is a memory resident program for reading text screens and speaking
  them via the Covox Speech Thing. Before loading STRES you must first load
  SPEECHV2 or SPEECHV3. Note that it is *not* necessary to load Covox's STALK
  memory resident program.

  Type STRES /? for a summary of options and commands.

  A dictionary file is an ASCII text file with one definition per line. A
  definition is the normal text spelling of a word followed by one or more
  spaces, followed by the phonetic spelling of the word using the SmoothTalker
  phonetic codes (see Appendix A of the Speech Thing User Manual). Lines that
  begin with a semicolon are treated as comments. Here's an example of a valid
  dictionary file:

;these entries just encode the standard pronunciations
ARBITRARILY    AArbIXtrEHr4IXl3IY
ARBITRATOR     AArbIXtr4EYDX3ER
COMPUTER       kAXmpy4UWDX3ER
DICTIONARY     dIHkSHAXn4EHr3IY

  Whenever STRES reads one of the words in the first column of the dictionary
  file, SmoothTalker pronounces it as specified by the phonetics of the second
  column.

  STRES.PAS requires TurboPower Software's Object Professional library (a
  commercial product) to compile. STRES.EXE is provided in this same archive.

  Written 10/90 by Kim Kokkonen, TurboPower Software
  Copyright (C) 1990, TurboPower Software. All rights reserved.
}

{$S-,I-,R-,V-,F-}
{$M 2048,0,655360}

program StRes;
  {-Resident interface to Speech Thing}

uses
  sthing, opinline, dos, opstring, opcrt, opint, optsr;

const
  modulename : string[5] = 'STRES';
  version = '1.00';
  screenhotkey   = $051F; {Ctrl-RShift-S}
  readerhotkey = $0513;   {Ctrl-RShift-R}
  waitfordos = false;
  speakit : boolean = false;

procedure message(s : string);
begin
  writeln(s);
  if SpeakIt then
    stspeak(s);
end;

procedure clearkbd;
  {-clear keyboard buffer}
var
  ch : char;
begin
  while keypressed do
    ch := readkey;
end;

var
  st : string;

function CharToWord(Ch : Char) : String;
  {-Return speakable string for character}
var
  St : String[39];
begin
  Ch := UpCase(Ch);
  case Ch of
    #32 : St := ' space';
    '!' : St := ' point';
    ',' : St := 'comma';
    '.' : St := 'period';
    ':' : St := 'colon';
    ';' : St := ' semicolon';
    '\' : St := 'backslash';
    '-' : St := ' dash';
    '[' : St := 'open bracket';
    ']' : St := 'close bracket';
    #39 : St := 'apostrofee';
    'A' : St := '~S9 EY';
    'K' : St := ' kay';
    'Q' : St := ' cue';
    'W' : St := 'S95'+Ch;
    'Z' : St := ' zzzzee';
  else
    St := 'S9 '+Ch;
  end;
  CharToWord := '<<'+St+'>>';
end;

procedure readst(y : byte);
begin
  fastread(screenwidth, y, 1, st);
  st := trimtrail(st);
end;

procedure speakline(y, x1, x2 : byte);
begin
  gotoxy(x1, y);
  if x2 = x1 then begin
    {spell character}
    if x1 > length(st) then
      stspeak(' ')
    else
      stspeak(chartoword(st[x1]));
  end else
    stspeak(copy(st, x1, x2-x1+1));
end;

procedure posspeak(x, y : byte; msg : string);
begin
  gotoxy(x, y);
  stspeak(msg);
end;

{$F+}
procedure readscreen(var regs : registers);
  {-read portions of the screen based on cursor movements}
var
  row : word;
  xy : word;
  sl : word;
  x : byte;
  y : byte;
  kw : word;
  done : boolean;
  e : byte;
begin
  reinitcrt;
  if not intextmode then begin
    stspeak(' not in text mode');
    exit;
  end;
  getcursorstate(xy, sl);
  stgrabint7e;
  clearkbd;
  blockcursor;

  y := hi(xy);
  x := lo(xy);
  fastread(screenwidth, y, 1, st);

  done := false;
  repeat
    kw := readkeyword;
    case kw of
      $4800 : {Up}
        if y > 1 then begin
          dec(y);
          readst(y);
          speakline(y, x, screenwidth);
        end else
          stspeak(' top of screen');

      $5000 : {Down}
        if y < screenheight then begin
          inc(y);
          readst(y);
          speakline(y, x, screenwidth);
        end else
          stspeak(' bottom of screen');

      $4B00 : {Left}
        if x > 1 then begin
          dec(x);
          speakline(y, x, x);
        end else
          stspeak(' left of screen');

      $7300 : {CtrlLeft}
        if length(st) <> 0 then begin
          if x = 1 then
            stspeak(' left of screen')
          else begin
            {scan to next word left}
            if st[x] <> ' ' then begin
              {currently within a word}
              dec(x);
              if st[x] = ' ' then
                {go to end of previous word}
                while (x > 0) and (st[x] = ' ') do
                  dec(x);
              {go to beginning of this word}
              while (x > 0) and (st[x] <> ' ') do
                dec(x);
              inc(x);
            end else begin
              {currently between words}
              {go to end of previous word}
              while (x > 0) and (st[x] = ' ') do
                dec(x);
              if (x <> 0) then
                {go to begin of previous word}
                while (x > 0) and (st[x] <> ' ') do
                  dec(x);
              inc(x);
            end;

            {find end of word}
            e := x;
            while (e <= length(st)) and (st[e] <> ' ') do
              inc(e);
            dec(e);

            speakline(y, x, e);
          end;
        end else begin
          x := 1;
          posspeak(x, y, ' left of screen');
        end;

      $4D00 : {Right}
        if x < screenwidth then begin
          inc(x);
          speakline(y, x, x);
        end else
          stspeak(' right of screen');

      $7400 : {CtrlRight}
        if length(st) <> 0 then begin
          if x = screenwidth then
            stspeak(' right of screen')
          else begin
            {scan to next word right}
            if st[x] <> ' ' then begin
              {currently within a word}
              while (x <= length(st)) and (st[x] <> ' ') do
                inc(x);
              if (x <= length(st)) then begin
                {skip over spaces after the word}
                while (x <= length(st)) and (st[x] = ' ') do
                  inc(x);
              end;
            end else begin
              {starting in white space}
              while (x <= length(st)) and (st[x] = ' ') do
                inc(x);
            end;

            if x <= length(st) then begin
              {find end of word}
              e := x;
              while (e <= length(st)) and (st[e] <> ' ') do
                inc(e);
              dec(e);
              speakline(y, x, e);
            end else
              posspeak(x, y, ' right of screen');
          end;
        end else begin
          x := 1;
          posspeak(x, y, ' right of screen');
        end;

      $4700 : {Home}
        begin
          x := 1;
          posspeak(x, y, ' left of screen');
        end;

      $4F00 : {End}
        begin
          x := screenwidth;
          posspeak(x, y, ' right of screen');
        end;

      $4900 : {PgUp}
        begin
          if y <> 1 then begin
            y := 1;
            readst(y);
          end;
          posspeak(x, y, ' top of screen');
        end;

      $5100 : {PgDn}
        begin
          if y <> screenheight then begin
            y := screenheight;
            readst(y);
          end;
          posspeak(x, y, ' bottom of screen');
        end;

      $4000, $1C0D, $011B : {F6, Enter, Esc}
        Done := True;

    end;
  until done;

  clearkbd;
  strestoreint7e;
  restorecursorstate(xy, sl);
end;

procedure speakscreen(var regs : registers);
  {-speak the entire screen regardless of cursor position}
var
  row : word;
  xy : word;
  sl : word;
begin
  reinitcrt;
  if not intextmode then begin
    stspeak(' not in text mode');
    exit;
  end;
  getcursorstate(xy, sl);
  stgrabint7e;
  clearkbd;
  blockcursor;
  row := 1;
  while (row <= screenheight) and not keypressed do begin
    gotoxy(1, row);
    readst(row);
    speakline(row, 1, screenwidth);
    inc(row);
  end;
  clearkbd;
  strestoreint7e;
  restorecursorstate(xy, sl);
end;
{$F-}

procedure externalifc(bp : word); interrupt;
var
  regs : intregisters absolute bp;
  savepsp : word;
begin
  case char(regs.ah) of
    'U' :
      begin
        savepsp := getpsp;
        regs.al := byte(disabletsr);
        setpsp(savepsp);
      end;
  end;
end;

procedure unloadfromcommandline;
var
  regs : intregisters;
  p : ifcptr;
begin
  p := moduleptrbyname(modulename);
  if p = nil then begin
    message(modulename+' not loaded');
    halt;
  end;
  restoreallvectors;
  regs.ah := Byte('U');
  emulateint(regs, p^.cmdentryptr);
  if regs.al = 1 then
    message(modulename+' unloaded')
  else
    message('Unable to unload '+modulename);
  halt;
end;

procedure analyzecommandline;
const
  lptnums : string[3] = '123';
var
  i : word;
  status : word;
  lpt : word;
  arg : comstr;

  procedure writehelp;
  begin
    st := modulename+', Version ';
    st := st+version;
    st := st+', by TurboPower Software';
    message(st);
    message('Usage:');
    st := '  '+modulename;
    st := st+' [options] [dictionaryfile]';
    message(st);
    message('Command line options:');
    message('  /L lptnum     specify line printer port (1, 2, 3)');
    message('  /S            speak installation messages');
    message('  /U            unload '+modulename+' from memory');
    message('Hot keys:');
    message('  [Ctrl-RightShift-R] for screen reader mode');
    message('  [Ctrl-RightShift-S] to speak whole screen');
    message('Screen reader mode:');
    message('  [Up]          read next line up');
    message('  [Down]        read next line down');
    message('  [Left]        read next character left');
    message('  [Right]       read next character right');
    message('  [Ctrl-Left]   read next word left');
    message('  [Ctrl-Right]  read next word right');
    message('  [Home]        move cursor to left of screen');
    message('  [End]         move cursor to right of screen');
    message('  [PgUp]        move cursor to top of screen');
    message('  [PgDn]        move cursor to bottom of screen');
    message('  [Enter],[Esc] exit from reader mode');
    halt;
  end;

  procedure invalidoption;
  begin
    message('Invalid command line option: '+arg);
    writehelp;
  end;

begin
  i := 1;
  while i <= paramcount do begin
    arg := stupcase(paramstr(i));
    case arg[1] of
      '/', '-' :
        if length(arg) = 2 then
          case arg[2] of
            '?' : writehelp;
            'L' : if i = paramcount then
                    invalidoption
                  else begin
                    inc(i);
                    arg := stupcase(paramstr(i));
                    if length(arg) <> 1 then
                      invalidoption
                    else begin
                      lpt := pos(arg[1], lptnums);
                      if lpt = 0 then
                        invalidoption
                      else
                        stsetlptport(lpt);
                    end;
                  end;
            'S' : speakit := true;
            'U' : unloadfromcommandline;
          else
            invalidoption;
          end;
    else
      {read dictionary file}
      status := streaddictfile(arg);
      if status <> 0 then begin
        st := long2str(status);
        st := 'Error '+st;
        st := st+' reading ';
        st := st+arg;
        message(st);
        halt;
      end else begin
        st := 'Dictionary '+arg;
        st := st+' loaded';
        message(st);
      end;
    end;
    inc(i);
  end;
end;

begin
  if not stloaded then begin
    writeln('SPEECHVx must be loaded first');
    halt;
  end;

  if paramcount <> 0 then
    analyzecommandline;

  if moduleinstalled(modulename) then begin
    message(modulename+' already installed. Aborting...');
    halt;
  end;

  installmodule(modulename, @externalifc);

  if definepop(screenhotkey, speakscreen, ptr(sseg, sptr), waitfordos) then
    if definepop(readerhotkey, readscreen, ptr(sseg, sptr), waitfordos) then begin
      st := 'Loading '+modulename;
      st := st+', Version ';
      st := st+version;
      st := st+', by TurboPower Software';
      message(st);
      message('  [Ctrl-RightShift-R] for screen reader mode');
      message('  [Ctrl-RightShift-S] to speak whole screen');
      strestoreint7e;
      popupson;
      stayres(paragraphstokeep, 0);
    end;

  message(modulename+' unable to go resident');
end.